Informática Multimedia 1995 April/Informatica Multimedia CD - Epimundo.iso/DOS/ARCHIVE/ZIPDEL.ZIP/ZIPDEL.PAS

Pascal/Delphi Source File | 1989-05-23 | 33.4 KB | 940 lines

PROGRAM ZIPDel (InFileSpec, Options);

{$B-,D+,R-,S-,V-}

USES TpCrt,TPDos,TPString,TPSpl,Dos;

CONST
  No         = False;
  Yes        = True;
  Bell       = #7;
  ArrayLimit = 1024;
  NL         = #13#10;

TYPE
  Line      = STRING[65];

  List      = RECORD
                Name  : STRING[12];
                Place : LONGINT;
                ASize : LONGINT;
                OSize : LONGINT;
                Date  : WORD;
                Time  : WORD;
                Group : BYTE;
              END;

  BigArray  = ARRAY [1..ArrayLimit] OF List;

  NPtr      = ^Dir_Rec;
  Dir_Rec   = RECORD
                Name : string[12];
                Next : NPtr;
                Prev : NPtr;
              END;

  Time_Date  = ARRAY [1..2] OF WORD;

VAR
  InFile      : FILE;
  OutFile     : FILE;
  InFileSpec  : Line;
  InFileName  : Line;
  InPath      : Line;
  DirToClean  : Line;
  Version     : Line;
  HeapPtr     : MarkRec;              { Pointer to heap for mark/release   }
  ListArray   : BigArray;
  ZIPCount    : WORD;
  NamePtr     : NPtr;
  Verify      : BOOLEAN;
  Test        : BOOLEAN;
  ForceDel    : BOOLEAN;
  DelFromZIP  : BOOLEAN;
  Match       : WORD;
  Output      : TEXT;
  FileNdx     : WORD;

(*----------------------------------------------------------------------*)
(*         Display_ZIP_Contents --- Display contents of ZIP file        *)
(*----------------------------------------------------------------------*)

PROCEDURE Display_ZIP_Contents( ZIPFileName : String ; Var ZipFile : File );

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*  Procedure: Display_ZIP_Contents                                     *)
(*                                                                      *)
(*  Purpose:   Displays contents of a ZIP file                          *)
(*                                                                      *)
(*  Calling sequence:                                                   *)
(*                                                                      *)
(*  Display_ZIP_Contents( ZIPFileName : String ; Var Zipfile : File);   *)
(*                                                                      *)
(*          ZIPFileName --- name of ZIP file whose contents are to be   *)
(*                          listed.                                     *)
(*                                                                      *)
(*          ZipFile - Handle of Zipfile to be read                      *)
(*                                                                      *)
(*                                                                      *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

(*----------------------------------------------------------------------*)
(*               Map of ZIP file entry headers                          *)
(*----------------------------------------------------------------------*)

CONST
   ZIP_Central_Header_Signature  = $02014B50;
   ZIP_Local_Header_Signature    = $04034B50;
   ZIP_End_Central_Dir_Signature = $06054B50;

   Open_Error    = 1               (* Error when opening file      *);
   Format_Error  = 2               (* Library format bad           *);
   End_Of_File   = 3               (* End of library directory     *);
   Too_Many_Subs = 4               (* Too many nested subdirs      *);
   Central_Dir_Found  = 5          (* Central directory sign found *);

TYPE
                                   (* Structure of a local file header *)
   ZIP_Local_Header_Type =
      RECORD
         Signature           : LONGINT  (* Header signature        *);
         Version             : WORD     (* Vers. needed to extract *);
         BitFlag             : WORD     (* General flags           *);
         CompressionMethod   : WORD     (* Compression type used   *);
         FileTime            : WORD     (* File creation time      *);
         FileDate            : WORD     (* File creation date      *);
         CRC32               : LONGINT  (* 32-bit CRC of file      *);
         CompressedSize      : LONGINT  (* Compressed size of file *);
         UnCompressedSize    : LONGINT  (* Original size of file   *);
         FileNameLength      : WORD     (* Length of file name     *);
         ExtraFieldLength    : WORD     (* Length of extra stuff   *);
      END;

                                   (* Structure of the central *)
                                   (* directory record         *)
   ZIP_Central_Header_Type =
      RECORD
          Signature           : LONGINT (* Header signature        *);
          VersionMadeBy       : WORD    (* System id/program vers. *);
          VersionNeeded       : WORD    (* Vers. needed to extract *);
          BitFlag             : WORD    (* General flags           *);
          CompressionMethod   : WORD    (* Compression type used   *);
          FileTime            : WORD    (* File creation time      *);
          FileDate            : WORD    (* File creation date      *);
          CRC32               : LONGINT (* 32-bit CRC of file      *);
          CompressedSize      : LONGINT (* Compressed size of file *);
          UnCompressedSize    : LONGINT (* Original size of file   *);
          FileNameLength      : WORD    (* Length of file name     *);
          ExtraFieldLength    : WORD    (* Length of extra stuff   *);
          CommentFieldLength  : WORD    (* Length of comments      *);
          DiskStartNumber     : WORD    (* Disk # file starts on   *);
          InternalAttributes  : WORD    (* Text/non-text flags     *);
          ExternalAttributes  : LONGINT (* File system attributes  *);
          LocalHeaderOffset   : LONGINT (* Where local hdr starts  *);
      END;

VAR

   ZIP_Entry     : ZIP_Central_Header_Type (* Central header       *);
   ZIP_Pos       : LONGINT      (* Current byte offset in ZIP file *);
   Bytes_Read    : INTEGER      (* # bytes read from ZIP file file *);
   Ierr          : INTEGER      (* Error flag                      *);
   Do_Blank_Line : BOOLEAN      (* TRUE to print blank line        *);
   File_Name     : String       (* File name of entry in ZIP file  *);
   Long_Name     : String       (* Long file name                  *);

(*----------------------------------------------------------------------*)
(* Get_Next_ZIP_Local_Header --- Get next local header in ZIP file      *)
(*----------------------------------------------------------------------*)

FUNCTION Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header :
                                        ZIP_Local_Header_Type;
                                    VAR Error : INTEGER  ) : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*    Function:  Get_Next_ZIP_Local_Header                              *)
(*                                                                      *)
(*    Purpose:   Gets next local header record in ZIP file              *)
(*                                                                      *)
(*    Calling sequence:                                                 *)
(*                                                                      *)
(*       OK := Get_Next_ZIP_Local_Header( VAR ZIP_Local_Header:         *)
(*                                            ZIP_Local_Header_Type;    *)
(*                                        VAR Error : INTEGER ) :       *)
(*                                        BOOLEAN;                      *)
(*                                                                      *)
(*          ZIP_Local_Header --- Local header data                      *)
(*          Error            --- Error flag                             *)
(*          OK               --- TRUE if header successfully found      *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   ZIP_Local_Hdr    : ZIP_Local_Header_Type   (* Local header         *);

BEGIN (* Get_Next_ZIP_Local_Header *)

                                   (* Assume no error to start       *)
   Error := 0;
                                   (* Position file                  *)
   Seek( ZIPFile , ZIP_Pos );
                                   (* Read in the file header entry. *)

   IF ( IOResult <> 0 ) THEN
      Error := Format_Error

   ELSE
      BEGIN

         BlockRead( ZIPFile, ZIP_Local_Header, SIZEOF( ZIP_Local_Header ),
                    Bytes_Read );

                                   (* If wrong size read, or header marker *)
                                   (* byte is incorrect, report ZIP file   *)
                                   (* format error.                        *)

          IF (ZIP_Pos = 0) AND
             ( ZIP_Local_Header.Signature <> ZIP_Local_Header_Signature) THEN
              Bytes_Read :=0;
                                   (* Check to see if this is a ZIP file   *)

         IF ( ( IOResult <> 0 ) OR
              ( Bytes_Read < SIZEOF( ZIP_Local_Header_Type ) ) ) THEN
            Error := Format_Error
         ELSE
                                    (* Check for a legitimate header type  *)

            IF ( ZIP_Local_Header.Signature = ZIP_Local_Header_Signature ) THEN
               BEGIN (* Local header -- skip it and associated data *)

                  ZIP_Pos := ZIP_Pos + ZIP_Local_Header.FileNameLength +
                                       ZIP_Local_Header.ExtraFieldLength +
                                       ZIP_Local_Header.CompressedSize +
                                       SIZEOF( Zip_Local_Header_Type );
               END

            ELSE IF ( ZIP_Local_Header.Signature = ZIP_Central_Header_Signature ) THEN
               BEGIN (* Central header -- we want this *)

                  Error := Central_Dir_Found;

               END

            ELSE IF ( ZIP_Local_Header.Signature = ZIP_End_Central_Dir_Signature ) THEN
               Error := End_Of_File;

      END;
                                    (* Report success/failure to calling *)
                                    (* routine.                          *)

   Get_Next_ZIP_Local_Header := ( Error = 0 );

END   (* Get_Next_ZIP_Local_Header *);

(*----------------------------------------------------------------------*)
(*     Get_Next_ZIP_Entry --- Get next header entry in ZIP file         *)
(*----------------------------------------------------------------------*)

FUNCTION Get_Next_ZIP_Entry( VAR ZIP_Entry : ZIP_Central_Header_Type;
                             VAR FileName  : String;
                             VAR Error     : INTEGER  ) : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*    Function:  Get_Next_ZIP_Entry                                     *)
(*                                                                      *)
(*    Purpose:   Gets header information for next file in ZIP file      *)
(*                                                                      *)
(*    Calling sequence:                                                 *)
(*                                                                      *)
(*       OK := Get_Next_ZIP_Entry( VAR ZIP_Entry :                      *)
(*                                     ZIP_Central_Header_Type;         *)
(*                                 VAR FileName  : String;              *)
(*                                 VAR Error     : INTEGER ) : BOOLEAN; *)
(*                                                                      *)
(*          ZIP_Entry --- Header data for next file in ZIP file         *)
(*          FileName  --- File name for this entry                      *)
(*          Error     --- Error flag                                    *)
(*          OK        --- TRUE if header successfully found, else FALSE *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   L     : INTEGER;
   L_Get : INTEGER;
   L_Got : INTEGER;

BEGIN (* Get_Next_ZIP_Entry *)
                                   (* Assume no error to start       *)
   Error := 0;
                                   (* Position file                  *)
   Seek( ZIPFile , ZIP_Pos );
                                   (* Read in the file header entry. *)

   IF ( IOResult <> 0 ) THEN
      Error := Format_Error

   ELSE
      BEGIN

         BlockRead( ZIPFile, ZIP_Entry, SIZEOF( ZIP_Central_Header_Type ),
                    Bytes_Read );

                                   (* If wrong size read, or header marker *)
                                   (* byte is incorrect, report ZIP file   *)
                                   (* format error.                        *)

         IF ( ( IOResult <> 0 ) OR
              ( Bytes_Read < SIZEOF( ZIP_Central_Header_Type ) ) ) THEN
            Error := Format_Error
         ELSE
                                    (* Check for a legitimate header type  *)

            IF ( ZIP_Entry.Signature = ZIP_Central_Header_Signature ) THEN
               BEGIN (* Central header -- we want this *)

                                   (* Pick up file name length.       *)
                                   (* Only first 255 chars retrieved. *)

                  L := ZIP_Entry.FileNameLength;

                  IF ( L > 255 ) THEN
                     L_Get := 255
                  ELSE
                     L_Get := L;

                                   (* Read file name characters. *)

                  BlockRead( ZIPFile, FileName[ 1 ], L_Get, L_Got );

                                   (* Check for I/O error *)

                  IF ( ( IOResult <> 0 ) OR ( L_Get<> L_Got ) ) THEN
                     Error := Format_Error
                  ELSE
                     BEGIN
                                   (* Position to next header *)

                        ZIP_Pos := ZIP_Pos + ZIP_Entry.ExtraFieldLength   +
                                             ZIP_Entry.CommentFieldLength +
                                             ZIP_Entry.FileNameLength     +
                                             SIZEOF( Zip_Central_Header_Type );

                                   (* Set length of file name *)

                        FileName[ 0 ] := CHR( L_Got );

                     END;

               END
                                   (* Check for end of directory *)

            ELSE IF ( ZIP_Entry.Signature = ZIP_End_Central_Dir_Signature ) THEN
               Error := End_Of_File

                                   (* Anything else is bogus *)
            ELSE
               Error := Format_Error;

      END;

   Get_Next_ZIP_Entry := ( Error = 0 );

END   (* Get_Next_ZIP_Entry *);

(*----------------------------------------------------------------------*)
(*   Find_ZIP_Central_Directory --- Find central ZIP file directory     *)
(*----------------------------------------------------------------------*)

FUNCTION Find_ZIP_Central_Directory( VAR Error : INTEGER ) : BOOLEAN;

(*----------------------------------------------------------------------*)
(*                                                                      *)
(*    Function:  Find_ZIP_Central_Directory                             *)
(*                                                                      *)
(*    Purpose:   Finds central ZIP file directory                       *)
(*                                                                      *)
(*    Calling sequence:                                                 *)
(*                                                                      *)
(*       OK := Find_ZIP_Central_Directory( VAR Error : INTEGER ) :      *)
(*                BOOLEAN;                                              *)
(*                                                                      *)
(*          Error    --- Error flag                                     *)
(*          OK       --- TRUE if header successfully found, else FALSE  *)
(*                                                                      *)
(*----------------------------------------------------------------------*)

VAR
   I             : INTEGER;
   J             : INTEGER;
   L             : LONGINT;
   ZIP_Local_Hdr : ZIP_Local_Header_Type   (* Local header         *);

BEGIN (* Find_ZIP_Central_Directory *)

                                   (* Assume no error to start          *)
   Error   := 0;
                                   (* Start at beginning of file.       *)
   ZIP_Pos := 0;
                                   (* Begin loop over local headers.    *)

                                   (* Report success/failure to calling *)
                                   (* routine.                          *)

   WHILE ( Get_Next_ZIP_Local_Header( ZIP_Local_Hdr , Error ) ) DO;

   Find_ZIP_Central_Directory := ( Error = Central_Dir_Found );

END   (* Find_ZIP_Central_Directory *);

(*----------------------------------------------------------------------*)
(*        Display_ZIP_Entry --- Display ZIP file file entry info        *)
(*----------------------------------------------------------------------*)

PROCEDURE Display_ZIP_Entry( ZIP_Entry : ZIP_Central_Header_Type ;
                             File_Name : String           );

VAR
   I         : INTEGER;
   L         : INTEGER;
   FName     : String;
   TimeDate  : LONGINT;
   TimeDateW : ARRAY[1..2] OF WORD ABSOLUTE TimeDate;

BEGIN (* Display_ZIP_Entry *)

   WITH ZIP_Entry DO
      BEGIN
                                   (* Pick up short file name.  Look *)
                                   (* for trailing '/', and extract  *)
                                   (* stuff beyond as file name.     *)
         FName := File_Name;

         I     := POS( '/' , FName );

         IF ( I > 0 ) THEN
            BEGIN

               L := LENGTH( FName );

               WHILE( FName[ L ] <> '/' ) DO
                  DEC( L );

               DELETE( FName, 1, L );

            END;

                                   (* Get date and time of creation *)

         TimeDateW[ 1 ] := FileTime;
         TimeDateW[ 2 ] := FileDate;

                                   (* Display this entry's information *)
         INC (FileNdx);
         ListArray[FileNdx].Name   := FName;
         ListArray[FileNdx].ASize  := CompressedSize;
         ListArray[FileNdx].Place  := 0;
         ListArray[FileNdx].OSize  := UnCompressedSize;
         ListArray[FileNdx].Date   := FileDate;
         ListArray[FileNdx].Time   := FileTime;
         ListArray[FileNdx].Group  := 0;
      END;

END (* Display_ZIP_Entry *);

(*----------------------------------------------------------------------*)

BEGIN (* Display_ZIP_Contents *)
                                   (* Open ZIP file and initialize *)
                                   (* contents display.            *)

                                   (* Skip to central directory in ZIP file *)

         IF Find_ZIP_Central_Directory( Ierr ) THEN

                                   (* Loop over entries      *)

            WHILE ( Get_Next_ZIP_Entry( ZIP_Entry , File_Name , Ierr ) ) DO
               Display_ZIP_Entry( ZIP_Entry , File_Name )

         ELSE
               WRITELN( 'Failed to find central ZIP directory for ', ZIPFileName );

                                   (* Close ZIP file file *)

END   (* Display_ZIP_Contents *);

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Usage                                    │
└────────────────────────────────────────────────────┘
}
PROCEDURE Usage;

BEGIN
  CLRSCR;
  WRITELN (Output,
'ZIPDEL 1.0 (C) 1989 by Ted Stephens ',NL,NL,
'ZIPDEL is used to clean up a directory by deleting the files that came',NL,
'out of archive (.ZIP) files, OR (2) clean up an ZIP file by deleting files',NL,
'in the ZIP file that exist in a directory.',NL,
'',NL,
'USAGE:     ZIPDEL [zip_file_template]{.ZIP}  {/options}',NL,
'',NL,
'Options must be listed singly, each one prefixed by the slash ("/")',NL,
'character AND spaced apart.  The options can be used in any combination.',NL,
'',NL,
'V :  Verify deletion by asking (yes/no) before deleting each file.',NL,
'F :  Force delete on matching filename even if there is a mismatch in',NL,
'     creation date, time, or file size.',NL,
'T :  Test -- no deletions at all, just report what would be deleted. ',NL,
'D :  Deletes FROM THE ZIP FILE, NOT THE DIRECTORY.',NL);
  Halt;
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Beep                                     │
└────────────────────────────────────────────────────┘
}

PROCEDURE Beep (message : STRING);

BEGIN
  WRITELN (Output, NL, message, NL);
  SOUND (560);
  DELAY (50);
  NOSOUND;
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Error_Message                            │
└────────────────────────────────────────────────────┘
}

PROCEDURE Error_Message (message : STRING);

BEGIN
  WRITELN (Output, Bell, NL, message, NL);
  HALT;                                     { ding bell & write message }
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE GET_FILENAME_LIST                        │
└────────────────────────────────────────────────────┘
}

PROCEDURE Get_FileName_List (InFileSpecV : Line; VAR NamePtrV : NPtr);

VAR                               { make list of ZIP files matching  }
  FileRecord : SearchRec;         { InFileSpecV                      }
  P1, P2, P3 : Nptr;
  FirstDir   : BOOLEAN;
  Placed     : BOOLEAN;

BEGIN
  FirstDir := True;
  NamePtrV := nil;
  P1       := nil;                { P1 is always "newest" pointer     }
  P2       := nil;                { P2 points to immediate past item  }
  P3       := nil;                { P3 is temp. ptr. for sort routine }

  FindFirst (InFileSpecV, AnyFile, FileRecord);
  IF DosError <> 0 THEN
    Error_Message ('No file found matching file specification')
  ELSE
    BEGIN
      WHILE DosError = 0 DO
        BEGIN
          IF FileRecord.Attr <> Directory THEN
            BEGIN
              NEW (P1);
              P1^.Name := FileRecord.Name;
              IF FirstDir = True THEN
                BEGIN
                  P1^.Next := nil;
                  P1^.Prev := nil;
                  P2       := P1;
                  FirstDir := False;
                END
              ELSE
                IF (P1^.Name < P2^.Name) THEN { Sort dir. names }
                    BEGIN
                      P1^.Next    := P2;
                      P1^.Prev    := nil;
                      P2^.Prev    := P1;
                      P2          := P1;
                    END
                  ELSE
                    BEGIN
                      P3     := P2;
                      Placed := False;
                      WHILE ((P3^.Next <> nil) AND (Placed = False)) DO
                        BEGIN
                          IF (P1^.Name >= P3^.Next^.Name) THEN
                            P3 := P3^.Next
                          ELSE
                           Placed := True;
                        END;
                      P1^.Next := P3^.Next;
                      P1^.Prev := P3;
                      P3^.Next^.Prev := P1;
                      P3^.Next := P1;
                    END;
            END;

          FindNext (FileRecord);
        END;

      NamePtrV := P2;
    END;
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE OPEN_INFILE                              │
└────────────────────────────────────────────────────┘
}

PROCEDURE Open_InFile (InFileNameV : Line; VAR InFile : FILE);

VAR
  FileAttr : word;

BEGIN
{$I-}
  ASSIGN (InFile,InFileNameV);
  IF IOresult <> 0 THEN Error_Message ('Error -- cannot assign filename ' +
                                        InFileNameV);

  GetFAttr (InFile, FileAttr);

  IF (FileAttr AND Directory) <> 0 THEN
    Error_Message ('Error -- input file ' + InFileNameV +
                   ' does not exist in current directory');

  RESET (InFile, 1);
  IF IOresult <> 0 THEN Error_Message ('Error -- cannot open input file ' +
                                        InFileNameV);
{$I+}
END;


{
┌────────────────────────────────────────────────────┐
│ PROCEDURE DelFile                                  │
└────────────────────────────────────────────────────┘
}

PROCEDURE DelFile (NameV : Line; message : Line);

VAR
  DelFile : File;

BEGIN
  ASSIGN (DelFile, NameV);
  ERASE (DelFile);
  WRITELN (Output, message);
END;


{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Test_for_Del                             │
└────────────────────────────────────────────────────┘
}

PROCEDURE Test_for_Del (VAR ListArray : BigArray;
                        DirToCleanV : Line; ZIPCountV : Word;
                        VerifyV, TestV, ForceDelV, DelFromZIPV : BOOLEAN;
                        VAR MatchV : WORD);

    {
    ┌────────────────────────────────────────────────────┐
    │ SUB FUNCTION EQUAL                                 │
    └────────────────────────────────────────────────────┘
    }

    FUNCTION Equal (VAR first, second; Size : WORD) : BOOLEAN;
    TYPE
      Bytes = ARRAY [0..4] OF BYTE;
    VAR
      n : INTEGER;
    BEGIN
      n     := 0;
      WHILE (n < Size) AND (Bytes(first)[n] = Bytes(second)[n]) DO
        INC (n);
      Equal := n = size;
    END;

    {
    ┌────────────────────────────────────────────────────┐
    │ SUB PROCEDURE MARK_ZIP                             │
    └────────────────────────────────────────────────────┘
    }
    PROCEDURE Mark_ZIP (VAR GroupV : BYTE; message : Line);
    BEGIN
      GroupV := 1;
      INC (Match);
      WRITELN (Output, message );
    END;

VAR
  i        : INTEGER;
  FileV    : SearchRec;
  OK       : BOOLEAN;
  TmDte    : Time_Date;
  Ch       : CHAR;
  CurFile  : Line;

BEGIN
  Match := 0;
  IF FileNdx > 0 THEN
    BEGIN
      IF DirToCleanV = '.\' THEN
        WRITELN (Output, 'Comparing ',InFileName,' to files in current directory',NL)
      ELSE
        WRITELN (Output, 'Comparing ',InFileName,' to files in ',DirToCleanV,NL);
    END;
  FOR i := 1 TO FileNdx DO
    BEGIN
      WRITE (Output, ListArray[i].name,'':12-LENGTH(ListArray[i].name));
      CurFile := DirToCleanV + ListArray[i].name;
      FindFirst (CurFile, AnyFile, FileV);
      IF DosError <> 0 THEN
        WRITELN (Output, ' -- Matching file not found')
      ELSE
        BEGIN
          OK := False;
          MOVE (FileV.Time, TmDte, SizeOf(FileV.Time));
          IF NOT EQUAL (ListArray[i].OSize, FileV.size, 4) THEN
            WRITE (Output, ' -- File size differs')
          ELSE
            IF NOT EQUAL (ListArray[i].date, TmDte[2], 2) THEN
              WRITE (Output, ' -- File date differs')
            ELSE
              IF NOT EQUAL (ListArray[i].time, TmDte[1], 2) THEN
                WRITE (Output, ' -- File time differs')
              ELSE
                OK := True;

          IF TestV THEN
            IF DelFromZIPV THEN
              WRITELN (Output, ' -- File found, but NOT deleted from ZIP file')
            ELSE
              WRITELN (Output, ' -- File found, but NOT deleted from directory')
          ELSE
            IF VerifyV THEN
              BEGIN
                WRITE (Output, ' -- Delete file?  (Y or N) ');
                Ch := ReadKey;
                IF (Ch = 'y') OR (Ch = 'Y') THEN
                  IF DelFromZIPV THEN
                    Mark_ZIP (ListArray[i].Group,' -- marked')
                  ELSE
                    DelFile (CurFile,' -- File deleted')
                ELSE
                  WRITELN (Output);
              END
            ELSE
              IF ForceDelV THEN
                IF DelFromZIPV THEN
                  Mark_ZIP (ListArray[i].Group,' -- File marked for deletion')
                ELSE
                  DelFile (CurFile,' -- File deleted')
              ELSE
                IF OK THEN
                  IF DelFromZIPV THEN
                     Mark_ZIP (ListArray[i].Group,' -- File marked for deletion')
                  ELSE
                    DelFile (CurFile,' -- File deleted')
                ELSE
                  WRITELN (Output,' -- file NOT deleted');
        END;
    END;

    IF TestV AND NOT DelFromZIPV THEN
      WRITELN (Output,NL,'Test specified -- directory files not deleted');
END;

{
┌────────────────────────────────────────────────────┐
│ PROCEDURE Read_Params                              │
└────────────────────────────────────────────────────┘
}

PROCEDURE Read_Params (VAR InFileSpecV : Line;
                       VAR InPathV     : Line;
                       VAR DirToCleanV : Line;
                       VAR VerifyV     : BOOLEAN;
                       VAR ForceDelV   : BOOLEAN;
                       VAR TestV       : BOOLEAN;
                       VAR DelFromZIPV : BOOLEAN);


VAR
  Param2 : Line;
  i      : INTEGER;

BEGIN

  VerifyV     := No;
  ForceDelV   := No;
  TestV       := No;
  DelFromZIPV := No;
  DirToClean  := '.\';
  i           := 0;

  IF (ParamCount = 0) OR (ParamStr(1) = '?') OR (ParamStr(1) = '/?') THEN
    Usage
  ELSE
    BEGIN
      InFileSpecV   := StUpCase(ParamStr(1));
      InFileSpecV   := DefaultExtension(InFileSpecV,'ZIP');
      InPathV := JustPathName(InFileSpecV);
      IF InPathV = '' then
           InPathV := DirToClean
      ELSE
           InPathV := InPathV + '\';
      FOR i := 2 TO ParamCount DO
        BEGIN
          Param2 := StUpCase(ParamStr(i));
          IF Param2[1] = '/' THEN
            CASE Param2[2] OF
              'V' :  VerifyV     := Yes;
              'F' :  ForceDelV   := Yes;
              'T' :  TestV       := Yes;
              'D' :  DelFromZIPV := Yes;
            END
          ELSE
            DirToCleanV := Param2 + '\';
        END;
        DirToCleanV := InPathV ;
    END;
END;

Procedure BuildNewZip;

Const

  ZipCommand : String[12] = 'Pkzip -d ';
  ZipResp    : String[12] = 'ZipFile.Rsp';

Var
  Response  : TEXT;
  ZipShell  : String;
  i         : Integer;
  DosOk,
  ZipOk,
  MakeZip   : Boolean;
  ZipTD     : Longint;

begin
  DosOk  :=No;
  MakeZip:=No;
  ZipOk  :=No;
  GetFTime(InFile,ZipTD);   (* Get time and date of old ZIP *)
  Close(Infile);            (* Close file before shell      *)
  IF Match = 0 THEN
    BEGIN
      WRITELN (Output);
      IF TEST THEN
        WRITELN (Output, 'Test specified -- ZIP file not changed')
      ELSE
        WRITELN (Output, 'No matching files in ZIP to delete');
      EXIT;
    END;
  IF Match = FileNdx THEN
    BEGIN
       WRITELN (Output);
       DelFile (InPath + InFileName,
               'All files in ZIP file match -- ZIP file is deleted');
      EXIT;
    END;
  Assign(Response,InPath + ZipResp);
  Rewrite(Response);
  for i := 1 to FileNdx Do
    Begin
      If ListArray[i].Group = 1 then
         Begin
           Writeln(Response,ListArray[i].Name);
           MakeZip:=Yes;
         End;
    End;
  Close(Response);
  If MakeZip then
    Begin
      WRITE(Output,NL,InFileName,'':12-LENGTH(InFileName));
      WRITE(Output,' -- ZIPing ');
      ZipShell := ZipCommand + Inpath + InFileName + ' @'+ InPath + ZipResp + ' >NUL';
      DosOk := 0 = ExecDos(ZipShell,True,nil) ;
      ZipOk := 0 = DosExitCode;
    End;
  If DosOk and ZipOk and MakeZip
       then Write(Output,' done.');
  Reset(Infile);                 (* Reopen to set time and date    *)
  SetFTime(InFile,ZipTD);        (* Set time and date same old Zip *)
  Close(InFile);                 (* Close for next Zip file        *)
  DelFile(InPath + ZipResp,'');  (* Delete response file for Pkzip *)
end; { procedure BuildNewZip }

{
┌────────────────────────────────────────────────────┐
│ MAIN PROGRAM                                       │
└────────────────────────────────────────────────────┘
}

BEGIN

  Version := 'Version 1.0, 3-15-89 -- Public Domain by Ted Stephens';
  MarkFL(HeapPtr);                              { Save the current heap ptr }

  ASSIGN (Output,'');
  REWRITE (Output);

  Read_Params (InFileSpec, InPath, DirToClean,
               Verify, ForceDel, Test, DelFromZIP);

  Get_FileName_List (InFileSpec, NamePtr);

  ClrScr;

  WHILE NamePtr <> nil DO
    BEGIN
      WRITELN (Output);

      FileNdx:=0;

      InFileName := NamePtr^.Name;

      Open_InFile (InPath + InFileName, InFile);

      Display_ZIP_Contents(Inpath + InfileName,InFile);

      Test_for_Del (ListArray, DirToClean, ZIPCount,
                    Verify, Test, ForceDel, DelFromZIP, Match);

      If DelFromZIP Then
           BuildNewZip;

      IF NOT DelFromZip Then CLOSE (InFile);

      WRITELN (Output);

      NamePtr := NamePtr^.Next;                { get next filename         }

    END; {while}

  ReleaseFL(HeapPtr);                           { Restore all mem allocated }

  Beep ('Processing done.');

  CLOSE (Output);

END.